000100* FUNCTION : CBU-log-print
000200* FILE : CBUP0004[.CBL]
000300 IDENTIFICATION DIVISION.
000400 PROGRAM-ID. CBUP0004.
000500 ENVIRONMENT DIVISION.
000600 CONFIGURATION SECTION.
000700 SPECIAL-NAMES.
000800     C01 IS NEXT-PAGE.
000900 INPUT-OUTPUT SECTION.
001000 FILE-CONTROL.
001100
001200* <MVS>
001300*    SELECT LogFile ASSIGN TO UT-S-CBUPRINT.
001400*    SELECT MsgFile ASSIGN TO UT-S-MESSAGES.
      * </MVS>
001500* <WIN>
001600     SELECT LogFile ASSIGN TO "CBUPRINT.DAT"
001700            ORGANIZATION IS LINE SEQUENTIAL.
001800     SELECT MsgFile ASSIGN TO "MESSAGES.DAT"
001900            ORGANIZATION IS LINE SEQUENTIAL.
      * </WIN>
002000
002100 DATA DIVISION.
002200
002300 FILE SECTION.
002400
002500 FD  LogFile BLOCK 0.
002600 01  LogLine.
002700     05 FILLER            PIC X.
002800     05 LINE-TO-PRINT     PIC X(120).
002900
003000 FD  MsgFile BLOCK 0.
003100 01  MsgLine.
003200     05 MSG1              PIC X(2).
003300     05 MSG2              PIC X(3).
003400     05 FILLER            PIC X.
003500     05 MSG3              PIC X(249).
003600
003700 WORKING-STORAGE SECTION.
003800
003900* COPYBOOKS
004000     COPY CBUC00W6.
004100
004200* VARIABLE USED BY THE PROGRAM ITSELF
004300
004400 01  INDEX1               PIC S9(4) COMP.
004500 01  INDEX2               PIC S9(4) COMP.
004600 01  INDEX3               PIC S9(4) COMP.
004700 01  INDEX4               PIC S9(4) COMP.
004800
004900 01  CALL-TYPE            PIC X(3)          VALUE "YES".
005000     88 FIRST-CALL                          VALUE "YES".
005100     88 FURTHER-CALL                        VALUE "NO".
005200
005300 01  PRINTER-STATUS       PIC X             VALUE SPACE.
005400     88 PRINTER-CLOSED                      VALUE "C".
005500     88 PRINTER-OPEN                        VALUE "O".
005600
005700 01  MSG-FILE-STATUS      PIC X             VALUE "C".
005800
005900 01  MSG-NUMBER           PIC S9(4) COMP    VALUE 0.
006000 01  MSG-ARRAY.
006100     05 MSG-LINE          OCCURS 150.
006200        10 MSG-NO         PIC XXX.
006300        10 MSG-TXT        PIC X(250).
006400 01  MESSAGE-TEXT-PART.
006500     05 MSGT              PIC X OCCURS 250.
006600 01  MESSAGE-VALUE-PART.
006700     05 MSGV              PIC X OCCURS 115.
006800 01  MSGTMAX              PIC S9(4) COMP.
006900 01  MSGVMAX              PIC S9(4) COMP.
007000
007100 LINKAGE SECTION.
007200
007300* COPYBOOK DESCRIBING THE CALLING INTERFACE BETWEEN
007400* A USER PROGRAM AND COBOLUNIT PRINT ROUTINE
007500     COPY CBUC0004.
007600
007700 PROCEDURE DIVISION
007800       USING CBU-LOG-PRINT-INTERFACE.
007900 mainline.
008000     IF FIRST-CALL
008100        PERFORM FIRST-CALL-ACTIONS
008200     END-IF.
008300
008400     IF CBU-CLOSE-PRINT-FILE
008500        IF PRINTER-OPEN
008600           CLOSE LogFile
008700           SET PRINTER-CLOSED TO TRUE
008800        END-IF
008900        GOBACK
009000     END-IF.
009100*     MOVE CBU-MESSAGE-TO-PRINT TO LINE-TO-PRINT
009200*     WRITE LogLINE
009300     PERFORM SEARCH-MESSAGE-TEXT.
009400
009500     PERFORM MERGE-TEXT-AND-VARIABLES.
009600
009700* THE RESULTING MESSAGE IS RETURNED BACK TO THE CALLING PROGRAM
009800     MOVE STRING-TO-BUILD TO CBU-COMPOSED-MSG.
009900
010000     EVALUATE TRUE
010100        WHEN CBU-PRINT-AS-A-TITLE
010200* PRINTS THE LINE ON NEXT PAGE WITHIN A FRAME
010300         PERFORM
010400             MOVE ALL "*" TO LINE-TO-PRINT
010500             WRITE LogLine AFTER ADVANCING NEXT-PAGE
010600             MOVE STRING-TO-BUILD TO LINE-TO-PRINT
010700             WRITE LogLine AFTER ADVANCING 1 LINES
010800             MOVE ALL "*" TO LINE-TO-PRINT
010900             WRITE LogLine AFTER ADVANCING 1 LINES
011000             MOVE ALL " " TO LINE-TO-PRINT
011100             WRITE LogLine AFTER ADVANCING 1 LINES
011200          END-PERFORM
011300        WHEN CBU-PRINT-ON-NEXT-PAGE
011400             MOVE STRING-TO-BUILD TO LINE-TO-PRINT
011500             WRITE LogLine AFTER ADVANCING NEXT-PAGE
011600        WHEN CBU-PRINT-AFTER-N-LINES
011700             MOVE STRING-TO-BUILD TO LINE-TO-PRINT
011800             WRITE LogLine
011900             AFTER ADVANCING CBU-PRINT-SPACING-NUM LINES
012000        WHEN OTHER
012100             MOVE STRING-TO-BUILD TO LINE-TO-PRINT
012200             WRITE LogLine AFTER ADVANCING 1 LINES
012300     END-EVALUATE.
012400     GOBACK.
012500
012600 FIRST-CALL-ACTIONS.
012700     MOVE LENGTH OF MESSAGE-TEXT-PART TO MSGTMAX
012800     MOVE LENGTH OF MESSAGE-VALUE-PART TO MSGVMAX
012900     SET FURTHER-CALL TO TRUE
013000     PERFORM LOAD-MESSAGES
013100     OPEN OUTPUT LogFile
013200     SET PRINTER-OPEN TO TRUE.
013300
013400 LOAD-MESSAGES.
013500     OPEN INPUT MSGFILE.
013600     MOVE "O" TO MSG-FILE-STATUS.
013700     READ MSGFILE AT END MOVE "C" TO MSG-FILE-STATUS.
013800     PERFORM UNTIL MSG-FILE-STATUS = "C"
013900* WE STORE IN THE MESSAGE ARRAY THE MESSAGES FOR THE LANGUAGE
014000* SELECTED THROUGH THE OPTIONS FILE OR THE LANGUAGE-INDEPENDANT
014100* MESSAGES AND IGNORE THE OTHERS
014200        if MSG1 = ".." OR CBU-MSG-LG
014300           ADD 1 TO MSG-NUMBER
014400           MOVE MSG2 TO MSG-NO (MSG-NUMBER)
014500           MOVE MSG3 TO MSG-TXT (MSG-NUMBER)
014600        END-IF
014610        READ MSGFILE AT END MOVE "C" TO MSG-FILE-STATUS END-READ
014700
014800     END-PERFORM.
014900     CLOSE MSGFILE.
015000
015100 SEARCH-MESSAGE-TEXT.
015200     PERFORM VARYING INDEX1 FROM 1 BY 1
015300        UNTIL INDEX1 > MSG-NUMBER
015400        OR MSG-NO (INDEX1) = CBU-MSG-NO
015500           CONTINUE
015600     END-PERFORM.
015700     IF MSG-NO (INDEX1) = CBU-MSG-NO
015800        MOVE MSG-TXT (INDEX1) TO MESSAGE-TEXT-PART
015900     ELSE
016000        STRING CBU-MSG-LG CBU-MSG-NO
016100           "UNDEFINED MESSAGE% % % % %"  DELIMITED BY SIZE
016200           INTO MESSAGE-TEXT-PART
016300     END-IF.
016400
016500  MERGE-TEXT-AND-VARIABLES.
016600     MOVE CBU-MSG-VAR TO MESSAGE-VALUE-PART.
016700     PERFORM INITIALIZE-NEW-STRING.
016800
016900     PERFORM INTERLEAVE
017000         UNTIL MESSAGE-TEXT-PART = SPACE
017100         AND MESSAGE-VALUE-PART = SPACE.
017200
017300 INTERLEAVE.
017400
017500     IF MESSAGE-TEXT-PART NOT = SPACE
017600        PERFORM VARYING INDEX1 FROM 1 BY 1
017700           UNTIL INDEX1 > MSGTMAX
017800           OR MSGT (INDEX1) = "%"
017900              CONTINUE
018000        END-PERFORM
018100        IF INDEX1 <= MSGTMAX AND MSGT (INDEX1) = "%"
018200           COMPUTE INDEX2 = INDEX1 - 1
018300           IF INDEX2 < 0 MOVE 1 TO INDEX2 END-IF
018400           MOVE MESSAGE-TEXT-PART (1 : INDEX2)
018500              TO STRING-TO-STRIP
018600           ADD 1 TO INDEX1
018700           COMPUTE INDEX2 = MSGTMAX - INDEX1
018800           MOVE MESSAGE-TEXT-PART (INDEX1 : INDEX2)
018900           TO MESSAGE-TEXT-PART
019000        ELSE
019100           MOVE MESSAGE-TEXT-PART TO STRING-TO-STRIP
019200           MOVE SPACE TO MESSAGE-TEXT-PART
019300        END-IF
019400        PERFORM BUILD-A-STRING
019500     END-IF.
019600     IF MESSAGE-VALUE-PART NOT = SPACE
019700        PERFORM VARYING INDEX1 FROM 1 BY 1
019800           UNTIL INDEX1 > MSGVMAX
019900           OR MSGV (INDEX1) = "%"
020000              CONTINUE
020100        END-PERFORM
020200        IF INDEX1 <= MSGVMAX AND MSGV (INDEX1) = "%"
020300           COMPUTE INDEX2 = INDEX1 - 1
020400           IF INDEX2 < 0 MOVE 1 TO INDEX2 END-IF
020500           MOVE MESSAGE-VALUE-PART (1 : INDEX2)
020600              TO STRING-TO-STRIP
020700           ADD 1 TO INDEX1
020800           COMPUTE INDEX2 = MSGVMAX - INDEX1
020900           MOVE MESSAGE-VALUE-PART (INDEX1 : INDEX2)
021000           TO MESSAGE-VALUE-PART
021100        ELSE
021200           MOVE MESSAGE-VALUE-PART TO STRING-TO-STRIP
021300           MOVE SPACE TO MESSAGE-VALUE-PART
021400        END-IF
021500        PERFORM BUILD-A-STRING
021600     END-IF.
021700
021800* STRING MANIPULATION ROUTINES
021900     COPY CBUC00P6.
